perm filename RHYC.F4[MUS,LCS]1 blob sn#030354 filedate 1974-01-08 generic text, type T, neo UTF8
00100	C  FILE NAME='RHYC'
00200	
00300	C   THIS IS FOR RHYTHMIC INPUT FROM BUTTONS.
00400	C   ORDER FOR EDITING WITH 'CONDUCT'.
00500	C   1. GET LISTING.   2. ADD,DELETE,CHANGE DURATIONS,TEMPO,METER.   
00600	C   3. QUICK TEMPO CHANGES MUST COME LAST!
00700	
00800		DIMENSION IV(200),V(200),W(600)
00900		COMMON V,N
01000	1700	BB=.1
01100	1032	TYPE 1000
01200	32	X=0
01300		I=1
01400		J=1
01500	1000	FORMAT(' INFO? OR WHAT?'/)
01600		ACCEPT 50,N
01700	50	FORMAT(A1)
01800		IF(N.EQ.'I')TYPE 2000
01900		IF(N.EQ.'I')GO TO 1032
02000	2000	FORMAT(' COMMANDS: R(EAD), S(AVE), L(IST), C(ONDUCT),
02100		1 E(DIT), TAP=<CR>'/' ALL RESTS, AS WELL AS NOTES, MUST BE 
02200		1 TAPPED.'/' IF THERE ARE NO TAPS FOR 10" THE LAST TAP IS TAKEN AS
02300		1 THE TERMINATION  OF THE INPUT.'/)
02400		IF((N.EQ.'R').OR.(N.EQ.'S'))GO TO 6
02500		IF(N.EQ.'E')GO TO 1013
02600		IF(N.EQ.'L')GO TO 24
02700	3001	TYPE 1001
02800	1001	FORMAT(' TAP ONCE, THEN PLAY RHYTHM'/)
02900		CALL RHYTHM(V,II)
03000		DO 2001 K=II+1,200
03100	2001	V(K)=0
03200		A=0
03300		L=1
03400		IF(N.EQ.'C')L=2
03500		DO 1021 K=L,II
03600	1021	A=A+V(K)
03700	2021	FORMAT(I4,' NOTES ',F8.3,'"'/)
03800		L=II
03900		IF(N.EQ.'C')L=L-1
04000		TYPE 2021,L,A
04100	21	FORMAT(2F)
04200		TYPE 12
04300	12	FORMAT(' OK=0,TRY AGAIN=1'/)
04400		ACCEPT 5,K
04500		ICON=0
04600		IF(K.EQ.1)GO TO 3001
04700		IF(N.NE.'C')GO TO 1032
04800	C   WHEN 'CONDUCTING', UPBEAT MUST BE TAPPED.
04900	C   METER OF UPBEAT (NOTE #0) MAY BE RESET.
05000		ALLM=1.
05100		ICON=-1
05200	3012	Q=ALLM
05300		DO 2012 K=3,II*3,3
05400	2012	W(K)=Q
05500		IF(ALLM.EQ.X)GO TO 300
05600		GO TO 1032
05700	24	IF(ICON)GO TO 100
05800	9024	N=0
05900	7024	FORMAT(/' DURATIONS OF NOTES',18XA5,12X,'TOTAL=',F7.3,' SECS.'/)
06000	8024	FORMAT(' NOTE 0 IS UPBEAT (NOT INCLUDED IN DURATION)')
06100		L=0
06200		IF(ICON)L=1
06300		K=1-L
06400		PRINT 7024,QSLAC,A
06500		IF(ICON)PRINT 8024
06600		DO 14 LL=1,40
06700		KA=K+1
06800		KB=KA+1
06900		KC=KB+1
07000		KD=KC+1
07100		PRINT 15,K,V(K+L),KA,V(KA+L),KB,V(KB+L),KC,V(KC+L),KD,V(KD+L)
07200		DO 16 M=1,5
07300		IF((V(K+M+L).EQ.0).OR.(V(K+M+L).EQ.999.0))GO TO 15
07400	16	CONTINUE
07500	14	K=K+5
07600	15	FORMAT(5('   (',I3,')',F7.3)/)
07700		CALL EXIT
07800	
07900	1013	TYPE 17
08000	17	FORMAT(' TYPE C(HANGE), A(DD NOTE), D(ELETE), T(EMPO CHANGE),
08100		1'/' M(ETER CHANGE), Q(UICK CHANGE), J(OIN), S(PLIT) OR <CR>'/)
08200		ACCEPT 50,K
08300		IF(K.EQ.'-1')GO TO 1013
08400	C   WITH 'CONDUCT', ADDED BEATS ARE IN TERMS OF REAL TIME.
08500		IF(K.EQ.'M')GO TO 101
08600		IF((K.NE.'C').AND.(K.NE.'Q'))GO TO 18
08700		TYPE 19
08800	19	FORMAT(' TYPE NOTE N'/)
08900	 	ACCEPT 5,KA
09000		IF(KA)GO TO 1013
09100		IF(K.EQ.'Q')GO TO 120
09200		L=KA
09300		IF(ICON)KA=KA+1
09400		TYPE 20,L,V(KA)
09500	20	FORMAT(' NOTE',I3,' WAS',F9.4,', CHANGE TO ',$)
09600		X=V(KA)
09700		ACCEPT 21,V(KA)
09800		IF(V(KA).LE.0)V(KA)=X
09900		A=A+V(KA)-X
10000		IF(ICON+1)GO TO 300
10100		GO TO 1013
10200	220	FORMAT(' BEAT',I3,', TF1=',F5.3,', TF2=',F5.3,/
10300		1 ' CHANGE TF1 TO ',$)
10400	120	L=KA*3+1
10500		TYPE 220,KA,W(L),W(L+1)
10600		ACCEPT 21,Y
10700		IF(Y.LE.0)GO TO 1013
10800		X=W(L+1)+W(L)-Y
10900		W(L)=Y
11000		W(L+1)=X
11100		KA=KA+2
11200		LA=L+2
11300		GO TO 1300
11400	C   QUICK CHANGES MUST BE DONE LAST. THEY ARE WIPED OUT WHEN ANY OTHER EDITING IS DONE!
11500	C   THEY MUST BE IN ORDER FROM 1 TO END.
11600	
11700	18	IF(K.NE.'A')GO TO 22
11800		TYPE 23
11900	23	FORMAT(' ADD AFTER WHICH NOTE?'/)
12000		ACCEPT 5,K
12100		IF(K)GO TO 1013
12200		IF(ICON)K=K+1
12300		TYPE 25
12400	25	FORMAT(' TYPE NOTE VALUE'/)
12500		ACCEPT 21,X
12600		IF(X.LE.0)GO TO 18
12700		A=A+X
12800	125	II=II+1
12900		IF(ICON)W((II-1)*3)=1.
13000		L=II+10
13100		DO 26 M=L,1,-1
13200		V(M)=V(M-1)
13300		IF(M-1.NE.K)GO TO 26
13400		V(M)=X
13500	C   'METERS' MUST BE CHECKED AFTER 'ADD' OR 'DELETE' IS USED.
13600		IF(ICON)GO TO 2300
13700		GO TO 1013
13800	26	CONTINUE
13900		GO TO 1032
14000	
14100	22	IF(K.NE.'D')GO TO 229
14200		TYPE 28
14300	28	FORMAT(' DELETE WHICH NOTE?'/)
14400	 	ACCEPT 5,K
14500		IF(K)GO TO 1013
14600		IF(ICON)K=K+1
14700		A=A-V(K)
14800	429	II=II-1
14900	C   KII WAS 1 IN NEXT LINE.
15000		DO 29 KA=K,II
15100	29	V(KA)=V(KA+1)
15200		V(II+1)=0
15300		IF(ICON)GO TO 2300
15400		GO TO 1013
15500	229	IF(K.NE.'J')GO TO 329
15600	C   JOINS NOTE TO FOLLOWING NOTE.
15700		TYPE 19
15800		ACCEPT 5,K
15900		IF(ICON)K=K+1
16000		V(K)=V(K)+V(K+1)
16100		K=K+1
16200		GO TO 429
16300	
16400	329	FORMAT(' TYPE % FOR 1ST NOTE.'/)
16500		IF(K.NE.'S')GO TO 35
16600	C   SPLITS NOTE BY %S.
16700		TYPE 19
16800		ACCEPT 5,K
16900		L=K
17000		IF(ICON)K=K+1
17100		TYPE 329
17200		ACCEPT 21,X
17300		Y=V(K)*X
17400		X=V(K)-Y
17500		V(K)=Y
17600		LA=L+1
17700		TYPE 529,L,V(K),LA,X
17800	529	FORMAT(2(' NOTE',I3,' =',F6.3/))
17900		GO TO 125
18000	
18100	410	KB=II
18200		KC=II
18300		KA=1
18400	1410	G=3.9
18500		ICNT=1
18600		LL='9'
18700		IF(KB.GT.51)KB=51
18800		KC=KC-KB
18900		KD=KB*2
19000	310	KK=9
19100		L=-1
19200	C   WATCH ARRAY LENGTHS HERE.
19300		J=KB
19400		IF(KA.GT.1)J=J+3
19500		DO 210 K=KA*3+1,(J+KA-1)*3-1,3
19600		X=W(K)
19700		Y=W(K+1)
19800		L=L+2
19900		IV(L)='. ' 
20000		IV(L+1)=' '
20100		IF(L.NE.KK)GO TO 1210
20200	2210	IV(L)=-2147483648
20300		KK=KK+10
20400	1210	IF((Y.LT.G+.05).AND.(Y.GT.G-.05))IV(L+1)=LL
20500	210	IF((X.LT.G+.05).AND.(X.GT.G-.05))IV(L)=LL
20600		X='  ' 
20700		IF(ICNT.EQ.10)X=' 180' 
20800		IF(ICNT.EQ.15)X=' 150' 
20900		IF(ICNT.EQ.20)X=' 120' 
21000		IF(ICNT.EQ.30)X='  60' 
21100		IF(ICNT.EQ.25)X='  90' 
21200		IF(ICNT.EQ.5)X=' 210' 
21300		IF(ICNT.EQ.33)X='  42' 
21400		PRINT 110,X,G,(IV(K),K=1,KD)
21500		ICNT=ICNT+1
21600	110	FORMAT(A4,F5.1,2X102A1)
21700		IF(G.LT..4)GO TO 510
21800		G=G-.1
21900		LL=LL-536870912
22000	C   ABOVE MOVES '9' TO '0' ETC.
22100		IF(LL.LT.'0')LL='9'
22200		GO TO 310
22300	510	IF(KA-2)LB='A'
22400		IF(LB.GE.'A')LB=LB-536870912
22500		LL=1
22600		Y=0
22700		M=(KB+KA-1)*3
22800		IF(M-KA*3.GE.150)M=M-1
22900		DO 610 K=KA*3,M,3
23000		IV(LL)=' '
23100		X=W(K)
23200		IF(X.EQ.1.)GO TO 610
23300		IF(X.EQ.Y)GO TO 1610
23400		LB=LB+536870912
23500		Y=X
23600	1610	IV(LL)=LB
23700	610	LL=LL+1
23800		IV(LL)=' '
23900	C  WHAT IF LAST BEAT IS NOT 4 16THS?
24000		KD=KB-KA*(1/KA)
24100		PRINT 710,(IV(K),K=1,KD)
24200	710	FORMAT(29X,'10',18X,'20',18X,'30',18X,'40'/11X50A2)
24300	C   200 BEAT LIMIT SO FAR.
24400		LL='A'
24500		X=1.
24600		LA=0
24700		DO 910 K=KA*3,M-1,3
24800		Y=W(K)
24900		L=Y/.25
25000		IF((Y.EQ.X).OR.(Y.EQ.1.).OR.(L.EQ.LA))GO TO 910
25100		LA=L
25200		PRINT 1110,LL,L
25300		LL=LL+536879012
25400	910	X=Y
25500		IF(KC.LE.0)GO TO 9024
25600		KA=KB+KA-1
25700	C  CHECK THIS OUT!!
25800		KB=KC
25900		PRINT 2410
26000		GO TO 1410
26100	2410	FORMAT('1')
26200	1110	FORMAT(1XA1,'=',I2,' 16TH NOTES')
26300	35	FORMAT(' TEMPO FACTOR IS 1, CHANGE TO'/)
26400		IF(K.NE.'T')GO TO 1032
26500		TYPE 35
26600		ACCEPT 21,X
26700		IF(X)GO TO 1013
26800		A=0
26900		IF(ICON)A=-V(1)/X
27000		DO 36 K=1,II
27100		V(K)=V(K)/X
27200	36	A=A+V(K)
27300		IF(ICON)GO TO 2300
27400		GO TO 1032
27500	
27600	100	IF(ICON+1)GO TO 410
27700	2300	W(1)=980000.
27800	300	W(2)=II*3-2
27900		KA=2
28000		LA=3
28100		X=Q/V(1)
28200	1300	L=LA
28300		DO 1200 K=KA,II
28400		Y=W(L)/V(K)
28500		W(L+1)=Y
28600		W(L+2)=Y
28700	1200	L=L+3
28800		L=LA
28900	3300	DO 500 K=KA,II
29000		Y=W(L)/V(K)
29100		Z=Y
29200		IF(K.LT.II)Z=W(L+4)
29300		B=ABS(Y-X)
29400		C=ABS(Z-Y)
29500		D=B-C/2
29600		IF(Y-X)GO TO 700
29700		IF(Z-Y)GO TO 900
29800		IF(D)GO TO 600
29900		IF(C.GE..05)B=-D
30000		IF(C.LT..05)B=-B*BB
30100	C   '.2' IS ARBITRARY.  TO SMOOTH JUMPS IN TEMPO.
30200		GO TO 200
30300	700	IF(Z-Y.LE.0)GO TO 800
30400		B=B*.5
30500		GO TO 200
30600	800	IF(D)GO TO 200
30700		IF(C.GE..05)B=D
30800		IF(C.LT..05)B=B*BB
30900		GO TO 200
31000	900	B=-B*.5
31100		GO TO 200
31200	600	B=-B
31300	200	W(L+1)=W(L+1)+B
31400		W(L+2)=W(L+2)-B
31500		X=W(L+2)
31600	500	L=L+3
31700	
31800		L=L-1
31900		DO 2100 K=1,7
32000	2100	W(L+K)=999.
32100		ICON=-2
32200		IF(N.EQ.'L')GO TO 410
32300		IF(N.EQ.'E')GO TO 1013
32400		GO TO 2
32500	
32600	101	FORMAT(' CHANGE WHICH BEAT?'/)
32700		TYPE 101
32800		ACCEPT 5,KA
32900	C   I.E.  3/8 = 4,8    5/16 = 4,16.
33000	
33100		TYPE 201
33200	201	FORMAT(' TYPE VALUE OF BEAT'/)
33300		X=0
33400		ACCEPT 5,(IV(K),K=1,8)
33500		DO 301 K=1,8
33600		Y=IV(K)
33700		IF(Y.LT.99.)GO TO 301
33800		ALLM=X
33900		GO TO 3012
34000	C   SETS METER FOR ALL BEATS IF LAST NUMBER IS .GE.99.
34100	301	IF(Y.NE.0)X=X+4./Y
34200		W(KA*3)=X
34300		GO TO 300
34400	C   FIX SO CHANGES GO FROM THIS POINT ON.
34500	C   QUICK CHANGES OF TEMPO MUST BE SET (OR RESET) AFTER! ANY OTHER EDITING.
34600	6	TYPE 2
34700		IF(N.EQ.'R')ICON=0
34800		IF(ICON.EQ.-1)GO TO 100
34900	2	FORMAT(' TYPE NAME'/)
35000		ACCEPT 4,QSLAC
35100		IF(QSLAC.EQ.'-1')GO TO 1032
35200		IF(QSLAC.NE.' ')GO TO 4
35300		QSLAC='BIN'
35400	4	FORMAT(A5)
35500	5	FORMAT(8I)
35600		CALL ZERPP
35700		IF(ICON)GO TO 1005
35800		IF(N.EQ.'R') GO TO 27
35900		DO 102 K=1,II+10
36000	102	W(K)=V(K)
36100	1005	CALL OFILE(1,QSLAC)
36200	10	DO 7 K=1,7
36300		IF(W(I).EQ.0)W(I)=999.0
36400	7	I=I+1
36500	8	WRITE(1,11)(W(K),K=J,J+6)
36600		IF((W(I-1).EQ.999.0).OR.(W(I-1).EQ.0))GO TO 9
36700		J=I
36800		GO TO 10
36900	C  'V' KEEPS BASIC DATA AT ALL TIMES, 'W' WILL HAVE MODIFIED DATA.(98000,WDCNT,TDUR,T1,T2,ETC.)
37000	9	WRITE(1)II,A,V,Q
37100		END FILE 1
37200		CALL EXIT
37300	27	CALL IFILE(1,QSLAC)
37400	30	READ(1,11)(W(K),K=J,J+6)
37500	 	IF(W(J+6).EQ.999.0)GO TO 6013
37600		J=J+7
37700		GO TO 30
37800	6013	READ(1)II,A,V,Q
37900		IF(W(1).GT.999.)ICON=-2
38000		GO TO 1032
38100	11	FORMAT(1X7F)
38200	111	FORMAT(I,202F)
38300		END